home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / linpklib / sasum.for < prev    next >
Text File  |  1983-12-31  |  924b  |  42 lines
  1.       REAL FUNCTION SASUM(N,X,INCX)
  2. C
  3. C     TAKES THE SUM OF THE ABSOLUTE VALUES.
  4. C     JACK DONGARRA, LINPACK, 3/11/78.
  5. C
  6.       REAL X(1),TEMP
  7.       INTEGER I,INCX,M,MP1,N,NINCX
  8. C
  9.       SASUM = 0.0E0
  10.       TEMP = 0.0E0
  11.       IF(N.LE.0)RETURN
  12.       IF(INCX.EQ.1)GO TO 20
  13. C
  14. C        CODE FOR INCREMENT NOT EQUAL TO 1
  15. C
  16.       NINCX = N*INCX
  17.       DO 10 I = 1,NINCX,INCX
  18.         TEMP = TEMP + ABS(X(I))
  19.    10 CONTINUE
  20.       SASUM = TEMP
  21.       RETURN
  22. C
  23. C        CODE FOR INCREMENT EQUAL TO 1
  24. C
  25. C
  26. C        CLEAN-UP LOOP
  27. C
  28.    20 M = MOD(N,6)
  29.       IF( M .EQ. 0 ) GO TO 40
  30.       DO 30 I = 1,M
  31.         TEMP = TEMP + ABS(X(I))
  32.    30 CONTINUE
  33.       IF( N .LT. 6 ) GO TO 60
  34.    40 MP1 = M + 1
  35.       DO 50 I = MP1,N,6
  36.         TEMP = TEMP + ABS(X(I)) + ABS(X(I + 1)) + ABS(X(I + 2))
  37.      *  + ABS(X(I + 3)) + ABS(X(I + 4)) + ABS(X(I + 5))
  38.    50 CONTINUE
  39.    60 SASUM = TEMP
  40.       RETURN
  41.       END
  42.